home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue36 / alfresco / BMSearch.pas next >
Encoding:
Pascal/Delphi Source File  |  1998-07-03  |  5.7 KB  |  194 lines
  1. {*********************************************************}
  2. {* BMSearch                                              *}
  3. {* Copyright (c) Julian M Bucknall 1998                  *}
  4. {* All rights reserved.                                  *}
  5. {*********************************************************}
  6. {* Boyer-Moore search routines                           *}
  7. {*********************************************************}
  8.  
  9. {Note: this unit is released as freeware. In other words, you are free
  10.        to use this unit in your own applications, however I retain all
  11.        copyright to the code. JMB}
  12.  
  13. {$IFNDEF Win32}
  14. !! Error: Sorry this unit will only compile in Delphi 2, 3, or 4
  15. {$ENDIF}
  16.  
  17. unit BMSearch;
  18.  
  19. interface
  20.  
  21. uses
  22.   SysUtils;
  23.  
  24. function BMPos(const aPattern : string;
  25.                const aText : string;
  26. {$IFDEF VER120} {ie, Delphi 4}
  27.                aNoCase : boolean = false;
  28.                aStartPos : integer = 1) : integer;
  29. {$ELSE}
  30.                aNoCase : boolean;
  31.                aStartPos : integer) : integer;
  32. {$ENDIF}
  33.  
  34. function BMPosSimple(const aPattern : string;
  35.                      const aText : string) : integer;
  36.  
  37.  
  38. implementation
  39.  
  40. uses
  41.   Windows;
  42.  
  43. type
  44.   PBoyerMooreSkips = ^TBoyerMooreSkips;
  45.   TBoyerMooreSkips = array [char] of byte;
  46.  
  47. function BMPos(const aPattern : string;
  48.                const aText : string;
  49. {$IFDEF VER120} {ie, Delphi 4}
  50.                aNoCase : boolean = false;
  51.                aStartPos : integer = 1) : integer;
  52. {$ELSE}
  53.                aNoCase : boolean;
  54.                aStartPos : integer) : integer;
  55. {$ENDIF}
  56. var
  57.   TextInx         : integer;
  58.   NewTextInx      : integer;
  59.   PatInx          : integer;
  60.   PatLen, TextLen : integer;
  61.   SkipValue       : integer;
  62.   WorkPattern     : string;
  63.   AllChars        : string;
  64.   LowerChars      : string;
  65.   Skips           : TBoyerMooreSkips;
  66.   LastChar        : char;
  67.   Matched         : boolean;
  68. begin
  69.   {quick easy checks}
  70.   PatLen := length(aPattern);
  71.   TextLen := length(aText);
  72.   if (aPattern = '') or (PatLen > TextLen) then begin
  73.     Result := 0;
  74.     Exit;
  75.   end;
  76.   if (PatLen > 255) then
  77.     raise Exception.Create('Pattern is too long');
  78.   {get the lowercased pattern if required}
  79.   if aNoCase then begin
  80.     WorkPattern := AnsiLowerCase(aPattern);
  81.     SetLength(AllChars, 256);
  82.     for TextInx := 1 to 255 do
  83.       AllChars[TextInx] := char(TextInx);
  84.     LowerChars := AnsiLowerCase(AllChars);
  85.     AllChars := '';
  86.   end
  87.   else
  88.     WorkPattern := aPattern;
  89.   {generate the skip values}
  90.   FillChar(Skips, sizeof(Skips), byte(PatLen));
  91.   SkipValue := pred(PatLen);
  92.   for PatInx := 1 to pred(PatLen) do begin
  93.     Skips[WorkPattern[PatInx]] := SkipValue;
  94.     dec(SkipValue);
  95.   end;
  96.   {start looking for the last character of the pattern}
  97.   LastChar := WorkPattern[PatLen];
  98.   if (aStartPos <= 1) then
  99.     TextInx := PatLen
  100.   else
  101.     TextInx := PatLen + aStartPos - 1;
  102.   while TextInx <= TextLen do begin
  103.     {calc the skip value, based on the current text character}
  104.     SkipValue := Skips[aText[TextInx]];
  105.     {if we don't have a match on the last character, skip}
  106.     if ((not aNoCase) and (LastChar <> aText[TextInx])) or
  107.        (aNoCase and (LastChar <> LowerChars[ord(aText[TextInx])])) then
  108.       inc(TextInx, SkipValue)
  109.     {if we do have a match on the last char, try matching the rest}
  110.     else begin
  111.       Matched := true;
  112.       Result := TextInx;
  113.       for PatInx := pred(PatLen) downto 1 do begin
  114.         dec(Result);
  115.         if ((not aNoCase) and
  116.             (WorkPattern[PatInx] <> aText[Result])) or
  117.            (aNoCase and
  118.             (WorkPattern[PatInx] <> LowerChars[ord(aText[Result])])) then begin
  119.           NewTextInx := Result + Skips[aText[Result]];
  120.           inc(TextInx, SkipValue);
  121.           if (TextInx < NewTextInx) then
  122.             TextInx := NewTextInx;
  123.           Matched := false;
  124.           Break;
  125.         end;
  126.       end;
  127.       if Matched then
  128.         Exit;
  129.     end;
  130.   end;
  131.   Result := 0;
  132. end;
  133.  
  134. function BMPosSimple(const aPattern : string;
  135.                      const aText : string) : integer;
  136. var
  137.   TextInx         : integer;
  138.   NewTextInx      : integer;
  139.   PatInx          : integer;
  140.   PatLen, TextLen : integer;
  141.   SkipValue       : integer;
  142.   Skips           : TBoyerMooreSkips;
  143.   LastChar        : char;
  144.   Matched         : boolean;
  145. begin
  146.   {quick easy checks}
  147.   PatLen := length(aPattern);
  148.   TextLen := length(aText);
  149.   if (aPattern = '') or (PatLen > TextLen) then begin
  150.     Result := 0;
  151.     Exit;
  152.   end;
  153.   if (PatLen > 255) then
  154.     raise Exception.Create('Pattern is too long');
  155.   {generate the skip values}
  156.   FillChar(Skips, sizeof(Skips), byte(PatLen));
  157.   SkipValue := pred(PatLen);
  158.   for PatInx := 1 to pred(PatLen) do begin
  159.     Skips[aPattern[PatInx]] := SkipValue;
  160.     dec(SkipValue);
  161.   end;
  162.   {start looking for the last character of the pattern}
  163.   LastChar := aPattern[PatLen];
  164.   TextInx := PatLen;
  165.   while TextInx <= TextLen do begin
  166.     {calc the skip value, based on the current text character}
  167.     SkipValue := Skips[aText[TextInx]];
  168.     {if we don't have a match on the last character, skip}
  169.     if (LastChar <> aText[TextInx]) then
  170.       inc(TextInx, SkipValue)
  171.     {if we do have a match on the last char, try matching the rest}
  172.     else begin
  173.       Matched := true;
  174.       Result := TextInx;
  175.       for PatInx := pred(PatLen) downto 1 do begin
  176.         dec(Result);
  177.         if (aPattern[PatInx] <> aText[Result]) then begin
  178.           NewTextInx := Result + Skips[aText[Result]];
  179.           inc(TextInx, SkipValue);
  180.           if (TextInx < NewTextInx) then
  181.             TextInx := NewTextInx;
  182.           Matched := false;
  183.           Break;
  184.         end;
  185.       end;
  186.       if Matched then
  187.         Exit;
  188.     end;
  189.   end;
  190.   Result := 0;
  191. end;
  192.  
  193. end.
  194.